MacTech 1 to 12/MacTech-vol-1-12.toast/Source/SAT 2.4.0 & updates ƒ/SAT-TCL and demo/SATTest/CSATTestDirector.p

Text File | 1995-12-18 | 6.1 KB | 239 lines | [TEXT/PJMM]

{****************************************************}
{}
{        CSATTestDirector.p                                                                                                                                                                                }
{}
{        Director methods for the SATTest application.                                                                                                    }
{}
{        Copyright © 1995 by Patrick C Hew. All rights reserved.                                                                }
{}
{****************************************************}


unit CSATTestDirector;

interface

    uses
        TCL, SATTestIntf;

implementation


{****************************************************}
{}
{        ISATTestDirector                                                                                                                                                                                        }
{}
{        Since the SAT director is responsible for setting up SAT, here we also give it    }
{        responsibility for sound. This isn't the only way of course, for instance, we        }
{        could make the application do it.                                                                                                                                                }

{****************************************************}

    procedure CSATTestDirector.ISATTestDirector (aSupervisor: CApplication);

    begin { ISATTestDirector }
        ISATDirector(aSupervisor);

        gCatchSound := nil;
    end; { ISATTestDirector }


{****************************************************}
{}
{        Free                                                                                                                                                                                                                                }
{}
{        Free the SAT director class, and close down our sounds. We have to call                    }
{        SATSoundShutup before deleting sounds, since deleting a sound which is                        }
{        playing is bad news.                                                                                                                                                                                }
{}
{****************************************************}

    procedure CSATTestDirector.Free;

    begin { Free }
        SATSoundShutup;

        if gCatchSound <> nil then begin
                SATDisposeSound(gCatchSound);
                gCatchSound := nil;
            end; { if }

        inherited Free;
    end; { Free }


{****************************************************}
{}
{        BuildWindow                                                                                                                                                                                                        }
{}
{        We build a window which has one pane, the SAT pane. Note the use of the                    }
{        existing TCL methods to fit the pane to the window.                                                                                    }
{}
{****************************************************}

    procedure CSATTestDirector.BuildWindow;

        var
            theWindow: CWindow;
            theRect: Rect;
            theSATPane: CSATPane;
            theScrollPane: CScrollPane;

    begin { BuildWindow }
        new(theWindow);
        itsWindow := theWindow;
        itsWindow.IWindow(WINDSATTest, kNotFloating, gDesktop, SELF);

        NEW(theScrollPane);
        theScrollPane.IScrollPane(itsWindow, SELF, 10, 10, 0, 0, sizELASTIC, sizELASTIC, kHasHScroll, kHasVScroll, kHasSizebox);
        theScrollPane.FitToEnclFrame(kDoHorizontal, kDoVertical);

        SetRect(theRect, 0, 0, 461, 308);

        new(theSATPane);
        itsSATPane := theSATPane;
        itsSATPane.ISATPane(theScrollPane, SELF, 10, 10, 0, 0, sizELASTIC, sizELASTIC, PICTColorBackground, PICTBWBackground, theRect, kNoUseMenuBar, kNoDither4Bit, kNoBeSmart);
        itsSATPane.FitToEnclosure(kDoHorizontal, kDoVertical);

        theScrollPane.InstallPanorama(itsSATPane);
        theScrollPane.SetSteps(8, 8);
        theScrollPane.SetOverlaps(72, 72);

        SetRect(theRect, 200, 150, 500, 350);
        itsWindow.SetSizeRect(theRect);

        gDecorator.PlaceNewWindow(itsWindow);
    end; { BuildWindow }


{****************************************************}
{}
{        SetUpSprites                                                                                                                                                                                                        }
{}
{        Set up the sprites for the player and the target.                                                                                                }
{}
{****************************************************}

    procedure CSATTestDirector.SetUpSprites;

        var
            theSpritePtr: SpritePtr;

    begin { SetUpSprites }
        theSpritePtr := SATNewSprite(0, 200, 200, @SetupPlayer);
        theSpritePtr := SATNewSprite(0, 0, SATRand(gSAT.offSizeV), @SetupTarget);
    end; { SetUpSprites }


{****************************************************}
{}
{        SetUpSprites                                                                                                                                                                                                        }
{}
{        Set up our"catch" sound.                                                                                                                                                                    }
{}
{****************************************************}

    procedure CSATTestDirector.SetUpSounds;

    begin { SetUpSounds }
        gCatchSound := SATGetNamedSound('TestSound');
    end; { SetUpSounds }


{****************************************************}
{}
{        UpdateMenus                                                                                                                                                                                                        }
{}
{        Enable the "Play catch" menu command.                                                                                                                        }
{}
{****************************************************}

    procedure CSATTestDirector.UpdateMenus;

    begin { UpdateMenus }
        inherited UpdateMenus;

        gBartender.EnableCmd(cmdPlayCatch)
    end; { UpdateMenus }


{****************************************************}
{}
{        DoCommand                                                                                                                                                                                                            }
{}
{        Check to see if we want to play a game. If so, do so.                                                                                }
{}
{****************************************************}

    procedure CSATTestDirector.DoCommand (theCommand: longint);

    begin { DoCommand }
        if theCommand = cmdPlayCatch then begin
                PrepareForPlaying;
                DoPlay;
                FinishPlaying;
            end; { if }
        inherited DoCommand(theCommand);
    end; { DoCommand }


{****************************************************}
{}
{        PrepareForPlaying                                                                                                                                                                                    }
{}
{        Hide the cursor and call the inherited method to prepare the pane.                                        }
{}
{****************************************************}

    procedure CSATTestDirector.PrepareForPlaying;

    begin { PrepareForPlaying }
        HideCursor;

        inherited PrepareForPlaying;
    end; { PrepareForPlaying }


{****************************************************}
{}
{        DoPlay                                                                                                                                                                                                                        }
{}
{        Implements a simple game loop.                                                                                                                                                }
{}
{****************************************************}

    procedure CSATTestDirector.DoPlay;

        const
            kTicksPerFrame = 2;

        var
            t: Longint;

    begin { DoPlay }
        while not Button do begin
                t := TickCount;
                SATRun(false);
                while TickCount < t + kTicksPerFrame do begin
                            { Nothing. }
                    end; { while }
            end; { while }
    end; { DoPlay }


{****************************************************}
{}
{        FinishPlaying                                                                                                                                                                                                        }
{}
{        Show the cursor.                                                                                                                                                                                            }
{}
{****************************************************}

    procedure CSATTestDirector.FinishPlaying;

    begin { FinishPlaying }
        ShowCursor;
    end; { FinishPlaying }


end. { CSATTestDirector }